home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue28 / tiptrix / FINDFILE.PAS next >
Encoding:
Pascal/Delphi Source File  |  1996-12-19  |  4.0 KB  |  123 lines
  1. procedure FindFile(initialPath : string;                 { initial path    
  2.       }
  3.                             fileMask : string;                   { mask to
  4. look For       }
  5.                             recursive: boolean;                { search
  6. subdirectories? }
  7.                             stopOnFirstMatch: boolean;   { one match?      
  8.       }
  9.                             files: TStringList);                  { add
  10. match(es) to list  }
  11. (* Starting at <initialPath>, FindFile will look for a match <fileMask>,
  12.    if <Recursive> is True, all subdirectories beneath <initialPath> will
  13.    be visited as well. If an initialPath is not given FindFile searches
  14.    all non-removeable drives. Adds the paths where <fileMask> found to
  15. <files> *)
  16.  
  17. type
  18.    TAryDrive = array[0..25] of char;
  19. const
  20.    aryDrive: TAryDrive = ('a', 'b', 'c', 'd' ,'e', 'f', 'g', 'h',
  21.                           'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p',
  22.                           'q', 'r', 's', 't', 'u', 'v', 'w', 'x',
  23.                           'y', 'z');
  24. var
  25.    currentPath, currentDrive: string;
  26.    i: byte;
  27.  
  28.    function IsDriveValid(drive: integer): boolean;
  29.    { returns true if a valid drive }
  30.    begin
  31.       { not searching removable drives }
  32.       Result := not (GetDriveType(drive) = DRIVE_REMOVABLE);
  33.       if Result then begin
  34.          ChDir(Format('%s:', [aryDrive[drive]]));
  35.          Result := (IOResult = 0);
  36.       end;
  37.    end;
  38.  
  39.    procedure SearchDirectory(fileMask: string; path: TFileName);
  40.       function MakePath(path, fileName: TFileName): TFileName;
  41.          function AddSlashIfNeeded(path: string): string;
  42.          begin
  43.             Result := Path;
  44.             if (not (path = '') and not (path[Length(path)] = '\')) then
  45.                Result := Format('%s\', [Result]);
  46.          end;
  47.       begin
  48.          Result := Concat(AddSlashIfNeeded(path), fileName);
  49.          writeln(Format('Path = %s', [Result]));
  50.       end;
  51.    var
  52.       searchRec: TSearchRec;
  53.       stopped: boolean;
  54.    begin
  55.       { search the current directory for fileMask }
  56.       stopped := False;
  57.       try
  58.          if FindFirst(MakePath(path, fileMask), faAnyFile, searchRec) = 0
  59. then
  60.             repeat
  61.                if searchRec.Attr <> faDirectory then begin
  62.                   files.Add(ExtractFilePath(MakePath(Path,
  63. searchRec.Name)));
  64.                   if stopOnFirstMatch then
  65.                      stopped := True
  66.                end
  67.             until (FindNext(searchRec) <> 0) or stopped;
  68.       finally
  69.          FindClose(searchRec);
  70.       end;
  71.  
  72.       if recursive then
  73.          {search the subdirectories for fileMask }
  74.          try
  75.             { Search current directory for subdirectories }
  76.             if FindFirst(MakePath(path, '*.*'), faDirectory, searchRec) = 0
  77. then
  78.                repeat
  79.                   with searchRec do
  80.                      if (Name <> '.') and (Name <> '..') and (Attr =
  81. faDirectory) then
  82.                         SearchDirectory(fileMask, MakePath(path, Name));
  83.                   { we have to be gentle to the others apps }
  84.                   Application.ProcessMessages;
  85.              until (FindNext(searchRec) <> 0) or stopped;
  86.          finally
  87.             FindClose(searchRec);
  88.          end;
  89.    end;
  90. begin
  91.    if initialPath <> '' then
  92.       SearchDirectory(fileMask, initialPath)
  93.    else begin
  94.       { bookmark current drive and directory }
  95.       GetDir(0, currentPath);
  96.       currentDrive := Copy(currentPath, 1, 1);
  97.  
  98.       for i := 0 to High(aryDrive) do
  99.          if IsDriveValid(i) then
  100.             SearchDirectory(fileMask, Format('%s:\', [aryDrive[i]]));
  101.  
  102.       { reset to previous path }
  103.       ChDir(Format('%s:', [currentDrive]));
  104.       ChDir(currentPath);
  105.    end;
  106. end;
  107.  
  108. procedure TForm1.FormCreate(Sender: TObject);
  109. const
  110.    fileMask = '*.dll';
  111. var
  112.    files: TStringList;
  113. begin
  114.    try
  115.       { fill combo box with all paths that contain <filemask> }
  116.       files := TStringList.Create;
  117.       FindFile('', fileMask, True, False, files);
  118.       comnboBox1.Items.Assign(files);
  119.    finally
  120.       files.Free;
  121.    end;
  122. end;
  123.